Tutoriel Gtk2Hs 6.2 - Boites d’événements et boites à boutons

Date de publication : 19/06/2014 21:41:58

Dans Gtk2Hs, un événement est quelque chose qui est envoyé à un widget par la boucle principale, habituellement en résultat d'une action effectuée par l'utilisateur. Le widget répond en retour en émettant un signal et c'est ce signal qui commande au programme de faire quelque chose. Pour le programmeur d'application Gtk2Hs, un événement est juste un type de données Haskell avec des champs nommés. Certains d'entre eux sont décrits dans la section Graphics.UI.Gtk.Gdk.Events de la documentation de l'API. Regardons par exemple le signal:

onButtonPress :: WidgetClass w => w -> (Event -> IO Bool) -> IO (ConnectId w)

Ce signal ne doit pas être confondu avec le signal émis quand un widget de type Button a été pressé. Le bouton dont on parle ici est le bouton de la souris . Le signal est émis quand un bouton de la souris est pressé quand celle-ci se trouve au dessus de ce widget.Le paramètre est une fonction qui prend un événement (qui doit avoir le constructeur Button) et retourne une valeur booléenne et une action d'entrée sortie IO. Les champs suivants pour Button sont tirés de l'API:

eventSent :: Bool
eventClick :: Click
eventTime :: TimeStamp
eventModifier :: [Modifier]
eventButton :: MouseButton
eventXRoot, eventYRoot :: Double

Le premier est utilisé pour le retour. Il apparaît dans tous les constructeurs Event tels que Motion, Expose, Key, Crossing, Focus, Configure, Scroll, WindowState, Proximity. De Event vous pouvez extraire toutes les informations concernant les actions de l'utilisateur. Voici un petit exemple:

onButtonPress eb 
                 (\x -> if (eventButton x) == LeftButton 
                           then do widgetSetSensitivity eb False 
                                   return (eventSent x)
                           else return (eventSent x))

Ici, le paramètre eb est le widget sous la souris et la fonction anonyme est du type décrit précédemment. Quelque chose est fait si le bouton gauche de la souris a été pressé et quand eventSent retourne la valeur booléenne attendue. Si un autre bouton de la souris est pressé, rien ne se produit et seul le booléen est retourné.

Maintenant, certains widgets n'ont pas de fenêtre associée et se contente de dessiner dans leur widget "parent". À cause de cela, ils ne peuvent pas recevoir d'événements et si ils sont mal dimensionnés, ils n'afficheront pas correctement le contenu dans la zone dédiée. Le widget EventBox fournit une fenêtre X pour ces widgets "enfants". Il s'agit d'une sous-classe de Bin qui possède également sa propre fenêtre et qui est une sous-classe de ContainerClass.

Pour créer une nouvelle EventBox, utilisez:

eventBoxNew :: IO EventBox

Pour ajouter un enfant, on utilise simplement:

containerAdd :: (ContainerClass self, WidgetClass widget) => self -> widget -> IO ()

La fenêtre peut être visible ou invisible et la boite d'événement peut être au dessus ou en dessous de l'enfant. Ceci est défini par:

eventBoxVisibleWindow :: Attr EventBox Bool    -- default True
eventBoxAboveChild :: Attr EventBox Bool       -- default False

Si vous voulez juste capturer des événements, alors la fenêtre sera rendue invisible. Si eventBox est au dessus de l'enfant, tous les événements iront au premier. Si elle est en dessous les événements iront au widget "enfant" en premier.

Une boite à boutons est une simple boite qui peut être utilisée pour empaqueter des boutons d'une façon standard. Il y en a de deux sortes, les horizontales et les verticales, et on les construit avec:

hbuttonBoxNew :: IO HButtonBox
vButtonBoxNew :: IO VButtonBox

buttonBoxSetLayout :: ButtonBoxClass self => self -> ButtonBoxStyle -> IO ()

Le style est un de ceux-ci : ButtonBoxDefaultStyle, ButtonBoxSpread, ButtonBoxEdge, ButtonBoxStart, ButtonBoxEnd. On n'empaquette pas les boutons comme dans une boite horizontale ou verticale standard, mais en utilisant la fonction containerAdd à la place.

La seconde fonctionnalité d'une boite à boutons est que l'on peut définir un ou plusieurs boutons pour être dans un groupe secondaire. Ceux-ci seront traités différemment lorsque la boite à boutons est redimensionnée. Par exemple, un bouton d'aide peut être isolé (visuellement) des autres. La fonction est:

buttonBoxSetChildSecondary :: (ButtonBoxClass self, WidgetClass child) => self -> child -> Bool -> IO ()

Cet exemple montre l'utilisation des boites d'événements et des boites à bouton:

Les boutons sont empaquetés dans une boite à bouton vertical avec le bouton play comme deuxième "enfant". Ce bouton contient aussi un mnémonique avec la combinaison de touches Alt-P. Les images sont placées dans des boites d'événements avec des fenêtres visibles et leur couleur de fond est définie avec:

widgetModifyBg eb StateNormal (Color 0 35000 0)

Comme mentionné dans le chapitre 5.3, StateType peut être StateNormal, StateActive, StatePrelight, StateSelected ou StateInsensitive.

Lorsque l'utilisateur clique le bouton gauche de la souris quand elle est au dessus d'une boite d'évènement, elle sera définie à StateInsensitive avec:

widgetSetSensitivity :: WidgetClass self => self -> Bool -> IO ()

Cela change le StateType à StateInsensitive et le widget ne répondra plus à aucun événement utilisateur. De plus, son apparence change. Dans l'exemple, on définit également la couleur de fond à gris clair.

import Graphics.UI.Gtk
import System.Random (randomRIO)

main :: IO ()
main= do
     initGUI
     window <- windowNew
     set window [windowTitle := "Slot Machine",
                 containerBorderWidth := 10,
                 windowDefaultWidth := 350, 
                 windowDefaultHeight := 400]                 
     hb1 <- hBoxNew False 0
     containerAdd window hb1
     vb1 <- vBoxNew False 0
     boxPackStart hb1 vb1 PackGrow 0
     vbb <- vButtonBoxNew
     boxPackStart hb1 vbb PackGrow 0
     resetb <- buttonNewWithLabel "Reset"
     containerAdd vbb resetb
     quitb <- buttonNewWithLabel "Quit"
     containerAdd vbb quitb
     playb <- buttonNewWithMnemonic "_Play"
     containerAdd vbb playb
     set vbb [buttonBoxLayoutStyle := ButtonboxStart, 
              (buttonBoxChildSecondary playb) := True ]

     let picfiles = ["./jacunda.gif", "./pacu.gif", "./tucunaream.gif"]
     evimls <- sequence (map (initEvent vb1) picfiles)
     tips <- tooltipsNew
     sequence_ $ map ((myTooltip tips) . fst) evimls

     onClicked playb (play evimls picfiles)

     onClicked resetb $ sequence_ (zipWith reSet evimls picfiles)

     onClicked quitb (widgetDestroy window)
     widgetShowAll window
     onDestroy window mainQuit
     mainGUI

initEvent :: VBox -> FilePath -> IO (EventBox, Image)
initEvent vb picfile = do
              eb <- eventBoxNew
              boxPackStart vb eb PackGrow 0
              slot <- imageNewFromFile picfile
              set eb[containerChild := slot, containerBorderWidth := 10 ]
              widgetModifyBg eb StateNormal (Color 0 35000 0)
              widgetModifyBg eb StateInsensitive (Color 50000 50000 50000)
              onButtonPress eb 
                 (\x -> if (eventButton x) == LeftButton 
                           then do widgetSetSensitivity eb False 
                                   return (eventSent x)
                           else return (eventSent x))
              return (eb, slot)

reSet :: (EventBox, Image) -> FilePath -> IO ()
reSet (eb, im) pf = do widgetSetSensitivity eb True                 
                       imageSetFromFile im pf  

play :: [(EventBox, Image)] -> [FilePath] -> IO ()
play eilist fplist = 
   do let n = length fplist
      rands <- sequence $ replicate n (randomRIO (0::Int,(n-1)))
      sequence_ (zipWith display eilist rands) where
                     display (eb, im) rn = do
                                  state <- widgetGetState eb
                                  if state == StateInsensitive 
                                     then return ()
                                     else imageSetFromFile im (fplist !! rn)   

myTooltip :: Tooltips -> EventBox -> IO ()
myTooltip ttp eb = tooltipsSetTip ttp eb "Click Left Mouse Button to Freeze" ""